COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE RSSER
C00004 00003	Initialize the world
C00006 00004	RS EXEC top level
C00008 00005	Command decoder
C00009 00006	Command service routines
C00011 00007	SSINF command
C00013 00008	 SSINF TTY line, program name
C00015 00009	AUXS Command
C00017 00010	CONN Command
C00019 00011	LINK Command
C00022 00012	 Link top level
C00024 00013	Random routines
C00026 ENDMK
C⊗;
TITLE RSSER
SUBTTL Definitions

; Mark Crispin, SU-AI, February 1978

; Assembly switches

IFNDEF SVRSKT,SVRSKT==365		; default listen socket
IFNDEF PDLLEN,PDLLEN==50		; stack length

; AC definitions.  0→3 are used by NETWRK

X=4 ? A=5 ? B=6 ? C==7 ? P=17

TERMID:	'TERMID				; for spies to see where we are
CORBEG==.				; start of initialized core storage
TERSTR:	BLOCK 10.			; console location string
ARGSTR:	BLOCK 20.			; argument string
LUSER:	BLOCK 1				; user name for USINF
FNDLSP:	BLOCK 1				; -1 → found a loser
ARGEND==.-1
ERSTRP:	BLOCK 1				; -1 → full error messages
AUXIOP:	BLOCK 1				; -1 → aux input opened
AUXOOP:	BLOCK 1				; -1 → aux output opened
INLNKP:	BLOCK 1				; -1 → in a link
LNKTTY:	BLOCK 1				; link TTY number
PDL:	BLOCK PDLLEN			; stack
COREND==.-1				; end of initialized storage
SUBTTL Initialize the world

RSSER:	JFCL
	RESET
	MOVE [SIXBIT/RSSER/]
	SETNAM
	SETZM CORBEG
	MOVE [CORBEG,,CORBEG+1]
	BLT COREND
	MOVE P,[PDL(-PDLLEN)]
	MOVSI 377777
	SETPR2				; map the system in
	 JRST 4,.-1
	OUTSTR [ASCIZ/RSSER started
/]

; Listen for a connection on our socket

	MOVEI SVRSKT
	MOVEM LSNSKT
	PUSHJ P,LISTEN

; Set up terminal id for interested spies

	MOVEI TERMID
	MOVEM JOBVER

; Log the connection

	OUTSTR [ASCIZ/Connected to /]
	PUSHJ P,MAPHST			; map in host table
	MOVE HOST
	PUSHJ P,HSTNUM			; get HDB
	 JFCL				; sorry about errors
	MOVEI A,(1)			; host name
	HRLI A,440700
	SKIPA X,[440700,,TERSTR]
CPYHST:	 IDPB B,X
	ILDB B,A
	JUMPN B,CPYHST
	HLRZ A,1			; pointer to system name
	MOVE B,(A)			; get system name
	MOVE A,FSOCKT			; and ICP socket
	CAMN B,[ASCII/TIP/]		; on a TIP?
	 TRNE A,177774			; just paranoia; make sure a TIP port
	  JRST NOTTIP
	MOVEI B,"#
	IDPB B,X
	LSH A,-16.
	IDIVI A,8.			; ports are octal
	JUMPE A,1DIGTP
	ADDI A,"0 ? IDPB A,X
1DIGTP:	ADDI B,"0 ? IDPB B,X
NOTTIP:	PUSHJ P,SETANM			; set our job name
	PUSHJ P,UNMHST			; map out the host table
	OUTSTR TERSTR
	OUTSTR [ASCIZ/
/]
	JRST RSEXC1			; skip prompt first time around
SUBTTL RS EXEC top level

RSEXEC:	MOVEI ↑M
	PUSHJ P,NETOCH
	MOVEI ↑J
	PUSHJ P,NETOCH
	MOVEI "@			; command prompt
	PUSHJ P,NETOCH
	PUSHJ P,NETSND
	SKIPE INLNKP
	 JRST LNKTPL
RSEXC1:	MOVE X,[440700,,A]
	SETZB A,ARGSTR			; clear command
	MOVE [ARGSTR,,ARGSTR+1]
	BLT ARGEND
CMDCHR:	PUSHJ P,NETICW
CMDREE:	CAIN ↑M				; end of command?
	 JRST XCTCMD
	CAIE <" >			; start of arguments?
	 JRST STOCHR
	MOVE X,[440700,,ARGSTR]
ARGCHR:	PUSHJ P,NETICW
	CAIN ↑M
	 JRST XCTCMD
	CAIL "a
	 CAILE "z
	  CAIA
	   SUBI "a-"A
	IDPB X
	JRST ARGCHR

STOCHR:	TRNN A,376			; command too long?
	 JRST [	CAIL "a			; no, convert case
		 CAILE "z
		  CAIA
		   SUBI "a-"A
		IDPB X			; and stuff it in
		JRST CMDCHR]
	MOVEI X,[ASCIZ/110 Command too long/]
	PUSHJ P,NETICW
	CAIE ↑M
	 JRST .-2
	PUSHJ P,NETICW			; eat LF
	JRST NEGACK
SUBTTL Command decoder

XCTCMD:	PUSHJ P,NETICW			; eat LF
	JUMPE A,CMDONE			; null command is always valid
	MOVSI B,-NUMCOM
	CAMN A,CMDTAB(B)
	 JRST @CMDSER(B)
	AOBJN B,.-2
	MOVEI X,[ASCIZ/100 No hablo dat/]
	JRST NEGACK

; Command tables

DEFINE CMDS
 CMD ERSTR
 CMD SSINF
 CMD USINF
 CMD AUXS
 CMD CONN
 CMD LINK
 CMD BREAK
 CMD NOOP
 CMD PTCL
 CMD QUIT
TERMIN

DEFINE CMD FOO
 IFG .LENGTH/FOO/-5,.ERR FOO bites the bag
 ASCII/FOO/
TERMIN

CMDTAB:	CMDS
NUMCOM==.-CMDTAB

DEFINE CMD FOO
 FOO
TERMIN

CMDSER:	CMDS
SUBTTL Command service routines

; ERSTR - Toggle error message verbosity

ERSTR:	SETCMM ERSTRP
CMDONE:	PUSHJ P,POSACK
	JRST RSEXEC

; NOOP - Just returns NOOP as a reply

NOOP:	PUSHJ P,POSACK
	JSP C,NETMSG
	 ASCIZ/NOOP/
	JRST CMDONE

; BREAK - Break links

BREAK:	PTYREL LNKTTY
	SETZM INLNKP
	JRST CMDONE

; PTCL - change protocol

PTCL:	SKIPN X,ARGSTR
	 JRST [	MOVEI X,[ASCIZ/120 What protocol?/]
		JRST NEGACK]
	CAMN X,[ASCII/GENRL/]
	 JRST CMDONE
	CAMN X,[ASCIZ/TENEX/]
	 SKIPA X,[[ASCIZ/120 Boy if you expect Tenex protocol out of me are you ever gonna lose/]]
	  MOVEI X,[ASCIZ/120 That protocol isn't implemented/]
	JRST NEGACK

; QUIT - terminate interaction and die

QUIT:	RESET
	EXIT

; USINF - status on a single user

USINF:	SKIPN ARGSTR			; any argument?
	 JRST [	MOVEI X,[ASCIZ/110 Who do ya want?/]
		JRST NEGACK]
	MOVE A,[440700,,ARGSTR]
	SETZ
USINF0:	ILDB B,A
	JUMPE B,[	MOVEM LUSER
			PUSHJ P,POSACK
			JRST USINFR]
	CAIL B,"a
	 CAILE B,"z
	  CAIA
	   SUBI B,"a-"A
	LSH 6
	ADDI -" (B)			; sixbitify and add in
	TLNN 77				; overflow?
	 JRST USINF0
	MOVEI X,[ASCIZ/110 User name too long/]
	JRST NEGACK
SUBTTL SSINF command

SSINF:	PUSHJ P,POSACK
	JSP C,NETMSG
	 ASCIZ/
Job    User  TTY Subsys/
USINFR:	MOVEI ↑M
	PUSHJ P,NETOCH
	MOVEI ↑J
	PUSHJ P,NETOCH
	MOVEI X,1			; start at job 1
SSINF0:	MOVE A,400210			; JBTSTS
	ADDI A,400000(X)
	MOVE A,(A)
	TLNN A,10000			; JLOG set?
	 JRST SSNXTJ			; no job or a phantom, ignore it
	MOVE A,400211			; PRJPRG
	ADDI A,400000(X)
	SKIPE A,(A)
	 CAMN A,[SIXBIT/*SEG*/]
	  JRST SSNXTJ
	SKIPN LUSER
	 JRST SSINF7
	HRRZ A,A
	CAME A,LUSER
	 JRST SSNXTJ
SSINF7: SETOM FNDLSP
	MOVEI <" >
	PUSHJ P,NETOCH
	MOVEI A,(X)
	IDIVI A,10.
	SKIPN A
	 MOVEI A," -"0
	MOVEI "0(A)
	PUSHJ P,NETOCH
	MOVEI "0(B)
	PUSHJ P,NETOCH
	MOVEI <" >
	PUSHJ P,NETOCH
	PUSHJ P,NETOCH
	MOVE A,400211			; PRJPRG
	ADDI A,400000(X)
	MOVE A,(A)
	MOVEI C,6
SSINF1:	SETZ B,
	ROTC A,6
	MOVEI " (B)
	PUSHJ P,NETOCH
	CAIN C,4
	 JRST [	MOVEI ",
		PUSHJ P,NETOCH
		SOJA C,SSINF1]
	SOJG C,SSINF1
	MOVEI <" >
; (continued on next page)
; SSINF TTY line, program name

	PUSHJ P,NETOCH
	MOVE A,400236			; JBTLIN
	ADDI A,400000(X)
	HRRZ A,(A)
	CAIN A,-1			; detached?
	 JRST [	JSP C,NETMSG
		 ASCIZ/Det/
		JRST SSINF2]
	IDIVI A,100
	IDIVI B,10
	JUMPE A,[	MOVEI <" >
			PUSHJ P,NETOCH
			JUMPN B,SSINF3
			PUSHJ P,NETOCH
			JRST SSINF4]
	MOVEI "0(A)
	PUSHJ P,NETOCH
SSINF3:	MOVEI "0(B)
	PUSHJ P,NETOCH
SSINF4:	MOVEI "0(C)
	PUSHJ P,NETOCH
SSINF2:	MOVEI <" >
	PUSHJ P,NETOCH
	MOVE A,400225			; JOBNAM
	ADDI A,400000(X)
	SKIPN A,(A)
	 JRST SSINF5
SSINF6:	SETZ B,
	ROTC A,6
	MOVEI " (B)
	PUSHJ P,NETOCH
	JUMPN A,SSINF6
SSINF5:	MOVEI ↑M
	PUSHJ P,NETOCH
	MOVEI ↑J
	PUSHJ P,NETOCH
SSNXTJ:	CAME X,400222			; hit last job?
	 AOJA X,SSINF0
	SKIPE LUSER			; not for SSINF
	 SKIPE FNDLSP
	  JRST CMDONE
	JSP C,NETMSG
	 ASCIZ/
User not logged in/
	JRST CMDONE
SUBTTL AUXS Command

AUXS:	SKIPN ARGSTR
	 JRST [	MOVEI X,[ASCIZ/110 What type and size?/]
		JRST NEGACK]
	LDB [260700,,ARGSTR]
	CAIE <" >			; direction must be a single character
	 JRST AUXSDE
	LDB [350700,,ARGSTR]		; get direction
	CAIN "R				; receive socket
	 JRST [	MOVEI A,4
		MOVEI C,1
		JRST AUXS1]
	CAIN "S				; send socket
	 JRST [	MOVEI A,5
		MOVEI C,2
		JRST AUXS1]
AUXSDE:	SKIPA X,[[ASCIZ/220 Bad direction specification/]]
AUXSSE:	 MOVEI X,[ASCIZ/221 Bad size specification/]
	JRST NEGACK
AUXS1:	LDB [100700,,ARGSTR]		; must be a single character
	JUMPN AUXSSE
	LDB [170700,,ARGSTR]
	CAIE "8
	 JRST AUXSSE
	PUSHJ P,POSACK
	ADD A,LSOCKT
	PUSHJ P,OCTOUT
	MOVEI <" >
	PUSHJ P,NETOCH
	MOVEI "0(C)
	PUSHJ P,NETOCH
	JRST CMDONE
SUBTTL CONN Command

CONN:	SKIPN ARGSTR
	 JRST [	MOVEI X,[ASCIZ/110 What handle and socket?/]
		JRST NEGACK]
	MOVE X,[440700,,ARGSTR]
	ILDB C,X			; get handle
	CAIE C,"1
	 CAIN C,"2
	  JRST GOTHDL			; got a handle on the situation
BADHDL:	MOVEI X,[ASCIZ/260 Bad handle/]
	JRST NEGACK
GOTHDL:	ILDB X
	JUMPE [	MOVEI X,[ASCIZ/110 What socket?/]
		JRST NEGACK]
	CAIE <" >
	 JRST BADHDL			; wanted a space here
	SETZ A,
GETSKT:	ILDB B,X
	CAIL B,"0
	 CAILE B,"7
	  JRST GOTSKT
	LSH A,3
	ADDI A,-"0(B)
	JRST GETSKT
GOTSKT:	CAIE C,"1			; receive connection?
	 JRST SNDCON
	TRNN A,1
	 JRST HOMOSK
	SUBI A,3			; fake out DATI's smarts
	MOVEM A,FSOCKT
	PUSHJ P,DATI			; open connection
	SETOM AUXIOP
	JRST CMDONE

SNDCON:	TRNE A,1
	 JRST HOMOSK
	SUBI A,2			; fake out DATO's smarts
	MOVEM A,FSOCKT
	MOVEI 8.
	PUSHJ P,DATO
	SETOM AUXOOP
	JRST CMDONE

HOMOSK:	MOVEI X,[ASCIZ/270 Homosocketual connections are illegal by California law/]
	JRST NEGACK			; the Anita Bryant feature
SUBTTL LINK Command

LINK:	SKIPN X,ARGSTR
	 JRST [	MOVEI X,[ASCIZ/110 With what to whom?/]
		JRST NEGACK]
	ANDCMI X,377
	CAME X,[ASCII/1 2 /]
	 CAMN X,[ASCII/2 1 /]
	  CAIA
	   JRST [	MOVEI X,[ASCIZ/110 Bad handle/]
			JRST NEGACK]
	SKIPE AUXIOP
	 SKIPN AUXOOP
	  JRST [MOVEI X,[ASCIZ/801 Connection not open/]
		JRST NEGACK]
	MOVEI X,377
	AND X,ARGSTR
	JUMPE X,[	MOVEI X,[ASCIZ/110 To whom?/]
			JRST NEGACK]
	PTYGET A
	 JRST [	MOVEI X,[ASCIZ/620 Can't get a PTY/]
		JRST NEGACK]
	HRRM A,LNKTTY
	MOVE B,A
	TLO B,1004
	PTSETL A
	MOVEI B,[ASCIZ/TALK /]
	PTWRS7 A
	LDB B,[010700,,ARGSTR]
	CAIL B,"0
	 CAILE B,"7
	  JRST NOTTYN
	MOVEI B,[ASCIZ/TTY/]
	PTWRS7 A
NOTTYN:	SKIPA X,[100700,,ARGSTR]
	 PTWR1W A
	ILDB B,X
	JUMPN B,.-2
	MOVEI B,↑M
	PTWR1W A
	MOVEI B,↑J
	PTWR1W A
	PTRD1W A
	CAIN B,"N
	 JRST [	MOVEI X,[ASCIZ/605 User not logged in/]
		PTYREL A
		JRST NEGACK]
	CAIE B,"T
	 JRST CHKFOK
	PTRD1W A			; thank you BH for making the fucking
	CAIE B,<" >			; messages so goddamned similar!
	 JRST .-2
	PTRD1W A			; thank you again BH!
	PTRD1W A			; thank you again BH!
	CAIE B,"T
	 JRST CHKFOK			; see if won now
	MOVEI X,[ASCIZ/601 User logged in more than once/]
	PTYREL A
	JRST NEGACK

CHKFOK:	CAIN B,"b
	 JRST [	MOVEI X,[ASCIZ/603 Refused by user/]
		PTYREL A
		JRST NEGACK]
	CAIE B,"O
	 JRST [	MOVEI X,[ASCIZ/604 Can't complete link for unknown reason/]
		PTYREL A
		JRST NEGACK]
	PTRD1W A
	CAIE B,<" >
	 JRST .-2
	MOVEI [	MOVE JOBCNI
		TLNE 20
		 JRST [	DEBREAK
			JRST QUIT]	; connection died--die!
		DISMIS]
	MOVEM JOBAPR
	MOVSI 1030			; INTPTO+INTIMS+INTINP
	CLKINT 5*60.
	INTENB
	SETOM INLNKP
	JRST CMDONE
; Link top level

LNKTPL:	PUSHJ P,NETICH			; get a command character
	 JRST LNKZZZ
	SETZB A,ARGSTR			; clear command
	MOVE X,[ARGSTR,,ARGSTR+1]
	BLT X,ARGEND
	MOVE X,[440700,,A]
	JRST CMDREE			; reenter command mode

LNKZZZ:	MOVE A,LNKTTY
	PTGETL A
	TLNN B,1
	 JRST QUIT			; link was broken
	IWAIT
LNKLUP:	PTRD1S A
	 JRST LNKLP1
LNKLP0:	MOVEI (B)
	CAIN 176			; }
	 MOVEI 175
	CAIN 32				; ~
	 MOVEI 176
	PUSHJ P,DATOCH
	PTRD1S A
	 JRST [	PUSHJ P,DATSND
		JRST LNKLP1]
	JRST LNKLP0
LNKLP1:	PUSHJ P,DATICH
	 JRST LNKTPL
	ANDI 177
	CAIN 176			; ~
	 MOVEI 32
	CAIN 175			; }
	 MOVEI 176
	CAIN 177
	 JRST LNKLP1			; we don't need rubouts
	MOVE B,
	CAIE B,↑C			; flush CALL
	 PTWR1W A
	JRST LNKLP1
SUBTTL Random routines

; Network octal output

OCTOUT:	IDIVI A,8.
	PUSH P,B
	SKIPE A
	 PUSHJ P,OCTOUT
	POP P,B
	MOVEI "0(B)
	JRST NETOCH

; Network text message

NETMSG:	HRLI C,440700			; called with JSP C,NETMSG
	ILDB C
	JUMPE 1(C)
	PUSHJ P,NETOCH
	JRST NETMSG+1

; Negative acknowledgement

NEGACK:	MOVEI "-
	PUSHJ P,NETOCH
	HRLI X,440700
NEGAK1:	ILDB X
	SKIPN ERSTRP			; verbosity mode on?
	 CAIE <" >			; no, is it a space?
	  CAIA
	   JRST RSEXEC			; space with ERSTR mode off
	JUMPE RSEXEC
	PUSHJ P,NETOCH
	JRST NEGAK1

; Positive acknowledgement

POSACK:	MOVEI "+
	JRST NETOCH

...LIT:	CONSTANTS

; Wonderful network routines

SVRRTS==-1				; include server routines
DATRTS==-1				; include data channel routines
ERRTNS==-1				; include error routines
ERRHAN==-1				; include automagic error handling
ERRINS==<JRST QUIT>			; error instruction
HSTTAB==-1				; include host table magic
HSTSIX==-1				; and alias name kludge

.INSRT NETWRK[NET,MRC]

END RSSER